perm filename III.NEW[GEM,BGB] blob
sn#054469 filedate 1973-07-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 III DISPLAY SUBROUTINES - BGB - JANUARY 1973.
C00004 00003 SUBRS DPYSET,DPYBIG,DPYBRT Set buffer,char. size, brightness*
C00006 00004 SUBRS AVECT,AIVECT,RVECT,RIVECT Vectors
C00009 00005 SUBRS DPYSTR,DTYO,DPYOUT Output string,character, POG *
C00012 00006 SUBRS OCTDPY,DECDPY,FLODPY Numeric display *
C00015 00007 NSUBR IIIDPY,WINDOW,GLASS Display device routine. *
C00018 00008 NSUBR YDPY,NODE
C00021 00009 NSUBR DPYARW,NODE
C00026 00010 ----- DPYARW continued.
C00028 00011 ARROW PARAMETERS:
C00029 00012 NSUBR VDPY,VERTEX SPECIAL VERTEX DISPLAY *
C00030 00013 NSUBR EDPY,EDGE SPECIAL EDGE DISPLAY *
C00032 00014 NSUBR FDPY,FACE Special Face display *
C00034 00015 NSUBR IDPY,NODE Identifier display. *
C00038 ENDMK
C⊗;
;III DISPLAY SUBROUTINES - BGB - JANUARY 1973.
↓A←1↔↓B←2↔↓C←3
INTERN BUFDPY,DPYPTR
BUFDPY: .+2↔=100↔BLOCK =100
INTERN DPYBUF
DPYBUF: DPYBU.↔=2048
DPYBU.: BLOCK =2048
IGNORE: BLOCK 1
SIZBRT: BLOCK 1
DPYCOL: BLOCK 1
DPYPTR: BLOCK 1
BUFEND: BLOCK 1
BUFHD: BLOCK 2 ;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
DDSAVE: BLOCK 1
;VERNIER III TEXT POSITIONING.
VERNX ←← 14
VERNY ←← 11
;SUBRS DPYSET,DPYBIG,DPYBRT ;Set buffer,char. size, brightness*
;____________________________________________________________________
NSUBR DPYSET,BUFFER ;Initialize a display buffer *
LAC 1,BUFFER↔CDR 2,-1(1) ;BUFFER SIZE.
ADDI 2,-1(1)↔DAC 2,BUFEND
ADDI 1,2↔DAC 1,BUFHD ;POINT TO THIRD WORD.
SETZM IGNORE
SETZM SIZBRT
CLR2: LAC A,BUFHD ;BLIT THE BUFFER WITH THE III-TEXT OPCODE 1.
LACI B,1↔DAC B,1(A)
LACI B,2(A)↔LIPI B,1(A)
BLT B,@BUFEND
PUSH P,(P)↔GO LV3
SUBREND DPYSET
;____________________________________________________________________
NSUBR DPYBIG,SIZE ;Set character size
;USES AC 1
; SKIPE IGNORE↔POP1J
; LAC A,SIZE↔LACI C,46↔DPB A,[POINT 3,3,27]
; PUSH P,(P)↔GO LV2
LAC A,SIZE↔DPB A,[POINT 3,SIZBRT,27] ;REMEMBER NEW SIZE
POP1J
SUBREND DPYBIG
;____________________________________________________________________
NSUBR DPYBRT,SIZE ;Set brightness
;USES AC 1
; SKIPE IGNORE↔POP1J
; LAC 1,SIZE↔LACI C,46↔DPB A,[POINT 3,3,24]
; PUSH P,(P)↔GO LV2
LAC A,SIZE↔DPB A,[POINT 3,SIZBRT,24] ;REMEMBER NEW BRIGHTNESS
POP1J
SUBREND DPYBRT
;SUBRS AVECT,AIVECT,RVECT,RIVECT ;Vectors
INTERN RIVECT,RVECT,AIVECT,AVECT
COMMENT ⊗
The III display processor is a stored program computer,
these III subroutines make a III program using only two display
operations: the long vector operation and the text operation. The
pointer to the display buffer is always maintained as a BYTE POINTER
to the last character displayed. The flag named IGNORE is set when
display buffer overflow occurs and all further display calls are
ignored until the buffer is used. The III instruction formats are
given below, unlike most CPU (but like must display processors of
its day) the immediate data fields are in the left portion of the
instruction and the opcode in the right.
TEXT DISPLAY WORD: ASCII/ABCDE/ + 1
LONG VECTOR WORD: BYTE(11)X,Y(3)BRT,SIZ(7)OPCODE
The long vector opcodes appear in the following four lines: ⊗
;USES AC 1-3
;DTYO DEPENDS ON THIS
RIVECT: SKIPA C,[046] ;RELATIVE INVISIBLE VECTOR.
RVECT: LACI C, 006 ↔GO LV0 ;RELATIVE VISIBLE VECTOR.
AIVECT: SKIPA C,[146] ;ABSOLUTE INVISIBLE VECTOR.
AVECT: LACI C, 106 ;ABSOLUTE VISIBLE VECTOR.
SETZM DPYCOL ;RESET TAB LOCATION
LV0: SKIPGE IGNORE↔POP2J
LV: LAC A,-2(P)↔LAC B,-1(P) ;PICKUP X AND Y.
LVC: DPB A,[POINT 11,C,10] ;PACK X INTO III-WORD.
DPB B,[POINT 11,C,21] ;PACK Y INTO III-WORD.
SKIPE A,SIZBRT ;NEW BRIGHTNESS OR SIZE?
GO [ IOR C,A↔DZM SIZBRT↔GO LV2] ;YES, SET IT
LV2: AOS A,DPYPTR↔DAC C,(A) ;PACK WORD INTO III-BUFFER.
LV3: LIPI A,<(<POINT 7,0,35>)> ;UPDATE DPYPTR...
DAC A,DPYPTR↔LACI A,(A) ;WHICH IS A BYTE-POINTER.
CAML A,BUFEND↔SETOM IGNORE ;CHECK FOR BUFFER OVERFLOW.
POP2J
;SUBRS DPYSTR,DTYO,DPYOUT ;Output string,character, POG *
;____________________________________________________________________
NSUBR DPYSTR,TEXT
;USES AC 1,3
LAC 3,TEXT↔LIPI 3,440700
ILDB 3↔JUMPE POP1J.
CALL(DTYO,0)↔GO DPYSTR+2
SUBREND DPYSTR
;____________________________________________________________________
NSUBR DTYO,CHAR
;USES AC 1
;DPYSTR DEPENDS ON DTYO NOT CLOBBERING 3
SKIPE SIZBRT
GO [ PUSHP 0↔PUSHP 2↔PUSHP 3
CALL(RIVECT,[0],[0])
POPP 3↔POPP 2↔POPP 0
GO .+1]
LAC 1,CHAR
CAIN 1,15
SETOM DPYCOL
CAIN 1,11
GO DOTAB
DTYO1: IDPB 1,DPYPTR
AOS DPYCOL
CDR 1,DPYPTR↔CAML 1,BUFEND
SETOM IGNORE↔POP1J
DOTAB: CALL(DTYO,[" "]) ;We got a tab, put out spaces until
MOVE 1,DPYCOL ;column is divisible by 8
TRNE 1,7
GO DOTAB
CDR 1,DPYPTR
POP1J
SUBREND DTYO
;____________________________________________________________________
NSUBR DPYOUT,POG
EXTERNAL IIISIM,OVERLAY,DDCHAN
SKIPN 1,BUFHD↔GO .+6
LAC 2,DPYPTR↔DAC 2,-2(1)
LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
CDR B,DPYPTR↔SUB B,BUFHD
AOS B↔DAC B,BUFHD+1
LAC 1,POG↔DPB A,[POINT 4,UPGOP,12]
SETOM 2↔TTYUUO 6,2
JUMPGE 2,[ TLNN 2,020000
POP1J
SKIPN 2,@DDSAVE
GO [ MOVE 2,[XWD 400000,177]
CALLI 2,400067
GO [ OUTSTR[ASCIZ/NO DATA DISC CHANNELS LEFT.
/]↔ GO L1 ]
HRRZM 2,@DDSAVE
GO L1 ]
L1: HRRZM 2,DDCHAN
CALL(IIISIM,UPGOP)
SETOM OVERLAY
MOVEI 2,1
MOVN 1,DDCHAN
ROT 2,-1(1)
MOVE 1,[XWD 002000,2]
VDSMAP 1,
JFCL
POP1J ]
XCT UPGOP
POP1J
UPGOP: 703B8+BUFHD
SUBREND DPYOUT
;____________________________________________________________________
NSUBR DDSET,PDDCHAN
MOVE 1,PDDCHAN
MOVEM 1,DDSAVE
SETZM OVERLAY
POP1J
SUBREND DDSET
;SUBRS OCTDPY,DECDPY,FLODPY ;Numeric display *
;____________________________________________________________________
NSUBR OCTDPY,INTEGER ;OCTAL NUMBER DISPLAY.
Q←15 ↔ N←13
SKIPA↔GO L2
LAC 14,INTEGER↔LAC Q,[POINT 3,14,-1]↔LACI N,6
L1: ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L1
CALL(DTYO,[" "])
L2: LAC 14,INTEGER↔LAC Q,[POINT 3,14,17]↔LACI N,6
L3: ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L3
POP1J
SUBREND OCTDPY;25-MAR-73(BGB)
;____________________________________________________________________
NSUBR DECDPY,INTEGER ;DECIMAL NUMBER DISPLAY.
LAC 1,INTEGER↔POPP -1(P) ;FETCH ARG AND MOVE RET. ADR.
L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
MOVM 2,1↔CALL(DTYO,["-"]) ;PRINT MINUS SIGN.
LAC 1,2
L2: IDIVI 1,12↔PUSH P,2 ;MODULO TEN AND SAVE.
SKIPE 1↔PUSHJ P,L2 ;TEST FOR DONE.
POP P,1↔ADDI 1,60↔CALL(DTYO,1) ;RESTORE & PRINT.
POP0J
SUBREND DECDPY;17-DEC-73(BGB)
;____________________________________________________________________
NSUBR FLODPY,FLONUM,PLACES ;FLOATING NUMBER DISPLAY. *
LAC FLONUM
JUMPL[CALL(DTYO,["-"])↔LACM FLONUM↔GO .+1]
LACM 2,PLACES↔CAILE 2,6↔LACI 2,6↔DAC 2,PLACES
FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
PUSHP 1↔CALL(DECDPY,0)↔POPP 0
LAC 2,PLACES
ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
PUSHP DPYPTR↔CALL(DECDPY,0)↔POPP 1
LACI "."↔IDPB 0,1
POP2J
SUBREND FLODPY;17-DEC-73(BGB)
NSUBR IIIDPY,WINDOW,GLASS ;Display device routine. *
E←←16
;DISPLAY WINDOW FRAME.
LAC 1,WINDOW
NIP 1(1)↔DAC XL ;PICK UP 2D CLIPPER WINDOW
NAP 1(1)↔DAC XH
NIP 2(1)↔DAC YL
NAP 2(1)↔DAC YH
CALL(DPYSET,DPYBUF) ;NEW POG
CALL(AIVECT,XL,YL) ;MAKE A BOARDER
CALL(AVECT,XH,YL)
CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)
CALL(AVECT,XL,YL)
;DISPLAY THE VISIBLE EDGE LIST.
LAC E,WINDOW
ALT2 E,E ;GET THE WORLD.
JUMPE E,L3 ;NOTHING THERE, RETURN
PED E,E↔SKIPA ;FIRST EDGE OF WORLD.
L1: ALT2 E,E↔JUMPE E,L3 ;GET AN EDGE.
X1DC 1,E↔Y1DC 2,E
CALL(AIVECT,1,2)
X2DC 1,E↔Y2DC 2,E
CALL(AVECT,1,2)
PVT 1,E ;CHECK EACH VERTEX FOR YNODES
CALL(YDPY,1)
L2: NVT 1,E
CALL(YDPY,1)
GO L1
L3: CALL(DPYOUT,GLASS)
POP2J
BEND IIIDPY; BGB 5 FEB 1973 --------------------------------------
DECLARE{XL,XH,YL,YH,TX,TY}
NSUBR YDPY,NODE
T←15
SIZ←14
LAC 1,NODE
TESTZ 1,NSEW+TBIT1 ;IF INVISIBLE, THEN SKIP THIS ONE
POP1J
PY T,1 ;GET TJOINT OR TEXT OF VERTEX
JUMPE T,POP1J. ;NOTHING THERE
DAC T,NODE
MOVE 0,(T)
ANDI 0,17
CAIE 0,$YNODE↔POP1J ;IF IT'S A TJOINT, LEAVE
MARK 1,TBIT1 ;REMEMBER WE'VE BEEN HERE
GO YDPY1
YDPY2: LAC T,NODE
PY T,T
JUMPE T,POP1J.
YDPY1: DAC T,NODE
YCODE 1,T
CAIN 1,$TEXTHD
GO DPYTXT
CAIN 1,$ARROW
GO [CALL(DPYARW,T)↔GO YDPY2]
FATAL(ILLEGAL YNODE FOUND)
DPYTXT:
CALL(DPYBRT,[1])
XDC 0,T↔FIXX 0, ;FETCH CO-ORDINATES
DAC 0,TX
YDC 0,T↔FIXX 0,
DAC 0,TY
DPSIZ SIZ,T
PTEXT T,T
SKIPN SIZ
MOVEI SIZ,1
CALL(DPYBIG,SIZ)
LAC 0,TY
DPYTX2: CAMGE 0,YH ;MAKE SURE IT'S WITHIN WINDOW
CAMGE 0,YL
GO DPYTX3
CALL AIVECT,TX,TY ;POSITION IT
DPYTX4: MOVEI 0,1(T)
CALL DPYSTR,0 ;DISPLAY IT (THIS MAY OVERFLOW EAST)
TESTZ T,CONBIT ;IS IT CONTINUED?
GO [ TCCW T,T ;YES, GET NEXT LINE
JUMPN T,DPYTX4 ;MAKE SURE THERE'S SOMETHING THERE
FATAL<Missing continuation of text node.> ]
DPYTX3: TCCW T,T ;GET NEXT TEXT NODE
JUMPE T,YDPY2 ;END OF LINE
; HRREI 0,-20 ;THIS REALLY SHOULD BE SIZE DEPENDENT
HRRZ 0,CHRSIZ(SIZ)
MOVN
ADDB 0,TY ;INCREMENT
GO DPYTX2
SUBREND YDPY
;Height of III characters
CHRSIZ: 30 ;0 (SAME AS 2)
20 ;1
30 ;2
34 ;3
40 ;4
60 ;5
100 ;6
140 ;7
CHROFF: XWD =-9,=-9 ;0 (SAME AS 2)
XWD =-8,=-7 ;1
XWD =-9,=-9 ;2
XWD =-9,=-11 ;3
XWD =-8,=-13 ;4
XWD =-9,=-16 ;5
XWD =-10,=-21 ;6
XWD =-11,=-25 ;7
NSUBR DPYARW,NODE
;Display an arrow
ACCUMULATORS{FLG,T1,N,V1,V2,DX1,DY1,DX2,DY2,X1,Y1}
ARWSIZ←←1
;Decide whether to make arrow this time
LAC N,NODE ;FETCH NODE IN QUESTION
TESTZ N,NSEW↔POP1J ;MAKE SURE IT'S NOT OFF SCREEN
TEST N,TBIT1↔POP1J ;HAVEN'T WE BEEN HERE BEFORE...
PARRW V2,N ;AND THE OTHER END
MARKZ N,TBIT1 ;SO WE WOULD COME THRU TWICE WITH SAME VERTEX
TESTZ V2,TBIT1 ;HAVE WE BEEN HERE YET?
POP1J ;NO, RETURN AND TRY AGAIN
;Check for off screen
TESTZ V2,NSEW↔POP1J ;CHECK FOR OFF SCREEN
PVT V2,V2 ;NOW GET SECOND VERTEX
TESTZ V2,NSEW↔POP1J ;CHECK FOR OFF SCREEN
PVT V1,N ;AND LASTLY THE FIRST VERTEX
TESTZ V1,NSEW↔POP1J ;CHECK FOR OFF SCREEN
LAC 0,XWC(V2) ;Calculate distance between points
FSBR 0,XWC(V1)
FMPR 0,0
LAC 1,YWC(V2)
FSBR 1,YWC(V1)
FMPR 1,1
FADR 0,1
LAC 1,ZWC(V2)
FSBR 1,ZWC(V1)
FMPR 1,1
FADR 0,1
CALL SQRT,0
MOVE X1,[POINT 7,ARWBLK] ;Convert to character stream
SETZ Y1,
CALL(WRFLO↑,0,<[JSP DY2,[IDPB 1,X1↔AOJA Y1,(DY2)]]>)
DAC Y1,CHRCNT
SETZ 1,
IDPB 1,X1
;Calculate extention, etc.
XDC DX1,V2 ;Fetch coordinates of V2
YDC DY1,V2
XDC DX2,N ;Fetch coordinates of V1'
YDC DY2,N
XDC 0,V1 ;Fetch coordinates of V1
YDC 1,V1 ; -→
FSBR DX1,0 ;Calculate E1
FSBR DY1,1 ; -→
FSBR DX2,0 ;Calculate E2
FSBR DY2,1 ; -→
FSC DX1,-1 ;Divide E1 by 2.0
FSC DY1,-1
FADR 0,DX1 ;This is the bisector of V1' and V2'
FADR 1,DY1
FADR 0,DX2
FADR 1,DY2
DAC 0,XCEN ;Save somewhere
DAC 1,YCEN
LAC 0,DX1 ;Normalize
LAC 1,DY1
CALL DIST
FDVR DX1,1
FDVR DY1,1
LAC 0,DX2 ;Normalize
LAC 1,DY2
CALL DIST
FDVR DX2,1
FDVR DY2,1
MOVN 0,DX2
MOVN 1,DY2
FMPR 0,K4
FMPR 1,K4
FADRM 0,XCEN
FADRM 1,YCEN
CALL(DPYBIG,[ARWSIZ])
MOVN X1,CHRCNT ;Calculate center of arrow
IMUL X1,CHRSIZ+ARWSIZ
FSC X1,231 ;(Float and divide by 4)
DACM X1,XOFFSET
FADR X1,XCEN
MOVN Y1,CHRSIZ+ARWSIZ
FSC Y1,232 ;(Float and divide by 2)
FADR Y1,YCEN
CAR 0,CHROFF+ARWSIZ ;Correct for losing III!
FSC 0,233
FADR X1,0
CDR 0,CHROFF+ARWSIZ
FSC 0,233
FADR Y1,0
CALL FAI
CALL(DPYSTR,[ARWBLK])
LAC 0,DX1
LAC 1,DY1
CALL DIST
LAC 1,CHRSIZ+ARWSIZ
FSC 1,232 ;(Float and divide by 2)
FDVRB 1,0
FMPR 0,DX1
FDVR 0,DY1
LACM 0,0
CAMGE 0,1
LAC 0,1
CAMLE 0,XOFFSET
LAC 0,XOFFSET
LAC 1,CHRSIZ+ARWSIZ
FSC 1,232 ;(Float and divide by 2)
FADR 0,1
DAC 0,K3
CALL HALF ;Do first half of arrow
MOVN DX1,DX1 ; -→
MOVN DY1,DY1 ;XChange sign of E1
EXCH V1,V2 ;Switch vertices
PARRW N,N ;And Ynodes
XDC DX2,N ;Fetch coordinates of V1'
YDC DY2,N
XDC 0,V1 ;Fetch coordinates of V1
YDC 1,V1 ; -→
FSBR DX2,0 ;Calculate E2
FSBR DY2,1 ; -→
LAC 0,DX2 ;Normalize
LAC 1,DY2
CALL DIST
FDVR DX2,1
FDVR DY2,1
CALL HALF
POP1J
;----- DPYARW continued.
DIST: FMPR 0,0 ;Calculate length of vector
FMPR 1,1
FADR 1,0
CALL SQRT↑,1
POP0J
HALF: LAC X1,V1 ;Draw extension
LACI Y1,DX2
LAC 0,K5
CALL OFFAI
LAC X1,N
SETZ 0,
CALL OFFAV
LAC X1,N ;Upper wing of arrow
LACI Y1,DX2
MOVN 0,K4
CALL OFFAI
PUSHP X1 ;Save start of arrow
PUSHP Y1
LAC 0,DX1
LAC 1,DY1
FMPR 0,K1
FMPR 1,K1
LAC X1,DX2
LAC Y1,DY2
FMPR X1,K2
FMPR Y1,K2
FADR 0,X1
FADR 1,Y1
FIX 0,233000
FIX 1,233000
CALL RVECT,0,1
MOVN 0,X1 ;Now the lower wing
MOVN 1,Y1
FIX 0,232000 ;(Doubles)
FIX 1,232000
CALL RIVECT,0,1
CALL AVECT ;(With arguments saved above)
MOVN X1,DX1 ;The main line of arrow
MOVN Y1,DY1
FMPR X1,K3
FMPR Y1,K3
FADR X1,XCEN
FADR Y1,YCEN
FAV: SETO FLG
GO FVECT
FAI: SETZ FLG,
GO FVECT
OFFAI: TDZA FLG,FLG
OFFAV: SETO FLG,
LAC 1,0
JUMPE 0,.+3
FMPR 0,(Y1)
FMPR 1,1(Y1)
YDC Y1,X1
XDC X1,X1
FADR X1,0
FADR Y1,1
FVECT: FIX X1,233000
FIX Y1,233000
JUMPE FLG,[CALL AIVECT,X1,Y1
POP0J]
CALL AVECT↑,X1,Y1
POP0J
DECLARE{XCEN,YCEN,CHRCNT,XOFFSET}
ARWBLK: BLOCK 10
;ARROW PARAMETERS:
COMMENT $
----- ⊗
↑ | |
| -→| K1 |←-
| | |____
K4 | / ↑
| | / | | |
| | / K2 |←- K3 -→|
↓ | / | | |
----- |/______↓________________________ .
-→|\ (Center of dimension)
E2| \
| \
| | \
↓ |
--- | -→
K5 E1
--- ⊗____________________________________________________________
↑
|
-→ -→
E1 = (DX1,DY1) E2 = (DX2,DY2)
$;
K1: 20.0
K2: 7.0
;K3: 20.0
DECLARE{K3} ;Set according to size of text
K4: 10.0
K5: 4.0
SUBREND DPYARW
NSUBR VDPY,VERTEX ;SPECIAL VERTEX DISPLAY *
LAC 1,VERTEX
; CAR 0,(1)↔ANDI 0,017400 ;NSEW & PZZ.
; SKIPE↔POP1J
TESTZ 1,NSEW!PZZ↔POP1J
XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
CALL(IDPY,VERTEX)
CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
POP1J
SUBREND VDPY;9-JAN-73(BGB)9-FEB-73(BGB)
NSUBR EDPY,EDGE ;SPECIAL EDGE DISPLAY *
CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
LAC 2,EDGE
PVT 1,2
; CAR 0,(1)↔ANDI 0,017400 ;NSEW &PZZ
; JUMPN 0,L1
TESTZ 1,NSEW!PZZ↔GO L1
XDC 0,1↔FIXX↔DAC X
YDC 0,1↔FIXX↔DAC Y
CALL AIVECT,X,Y
CALL (DTYO,["+"])
CALL AIVECT,X,Y
L1: LAC 2,EDGE
NVT 1,2
; CAR 0,(1)↔ANDI 0,017400
; JUMPN 0,L2
TESTZ 1,NSEW!PZZ↔GO L2
XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0
CALL AVECT
CALL (DTYO,["-"])
L2: LAC 2,EDGE
LAC X↔ASH -1↔PUSH P,0
LAC Y↔ASH -1↔PUSH P,0
CALL AIVECT
CALL IDPY,EDGE
CALL (DPYBIG,[2])
CALL (DPYBRT,[2])
POP1J
DECLARE{X,Y}
SUBREND EDPY;9-FEB-73(BGB),9-FEB-73(BGB)
NSUBR FDPY,FACE ;Special Face display *
EXTERN ECCW
LAC 1,FACE↔DAC 1,F
TEST 1,FBIT↔POP1J
PED 2,1↔DAC 2,E↔DAC 2,E0
SETZM I
CALL(DPYBIG,[1])
CALL(DPYBRT,[3])
SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
X1DC 0,2↔DAC 0,X
Y1DC 1,2↔DAC 1,Y
CALL(AIVECT,0,1)↔LAC 2,E
X2DC 0,2↔ADDM 0,X
Y2DC 1,2↔ADDM 1,Y
CALL(AVECT,0,1)
LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
CALL(AIVECT,0,1)
CALL(DECDPY,I)
L2: CALL(ECCW,E,F)
CAMN 1,E↔GO L3↔DAC 1,E
CAME 1,E0↔GO L1
L3: CALL(DPYBRT,[2])
CALL(DPYBIG,[2])
POP1J
DECLARE{F,E,E0,X,Y,I}
SUBREND FDPY;9-FEB-73(BGB)
NSUBR IDPY,NODE ;Identifier display. *
EXTERN CAMERA
EXTERN NTYPE
EXTERN NNAMES
CALL(NTYPE,NODE)↔CAIGE 1,$BODY↔GO L5
LAC 1,NODE↔SETZ 2,
TESTZ 1,BBIT↔GO[
SKIPE 13,-2(1)↔GO[
LAC 14,-1(1)↔DZM 15
CALL(DPYSTR,[13])↔POP1J]
L1: CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
CALL(DECDPY)↔POP1J]
TESTZ 1,FBIT↔GO[
L2: NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
CALL(DECDPY)↔POP1J]
TESTZ 1,EBIT↔GO[
L3: NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
CALL(DECDPY)↔POP1J]
TESTZ 1,VBIT↔GO[
L4: NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
CALL(DECDPY)↔POP1J]
CALL NTYPE,NODE
L5: CALL DPYSTR,NNAMES(1)
LAC 1,NODE↔CAMN 1,UNIVERSE↔POP1J
$TYPE 2,1↔DZM 5 ;NODE - TYPE - COUNT.
LAC 3,UNIVERSE↔SON 3,3↔DAC 3,4 ;SON0 - SON.
CAME 1,4↔GO[$TYPE 0,4↔CAMN 0,2↔AOS 5↔SIS 4,4
CAME 3,4↔GO .-1↔GO .+1]↔AOS 5
CALL(DECDPY,5)
POP1J
BEND IDPY; BGB 4 FEBRUARY 1973 -----------------------------------
END